home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / fielddh.exe / FILE_LIB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-06  |  3.3 KB  |  117 lines
  1. {$F+,O+}   {since used to determine if overlay file exists!}
  2. UNIT File_Lib;
  3. INTERFACE
  4.   function File_Exist (File_Name : string) : boolean;
  5.  
  6.   function Find_File_Along_Path (File_Name : string) : string;
  7.  
  8.                             {* Assumes path ends with a '/'   *}
  9.   procedure Check_Valid_Path (Path_To_Ck     : string;
  10.                               VAR Ret_Status : integer);
  11.  
  12.   function Get_Unique_FileName : string;
  13.  
  14.   procedure Erase_File (File_Name  : string;
  15.                         Var Status : byte);
  16.  
  17. IMPLEMENTATION
  18. USES
  19.   Str_Stf,
  20.   DOS;
  21.  
  22. {***********************************************************************}
  23. function File_Exist (File_Name : string) : boolean;
  24. var
  25.   DirInfo  : DOS.SearchRec;
  26. begin
  27.   DOS.FindFirst (File_Name, DOS.AnyFile, DirInfo);
  28.  
  29.   IF (DOS.DosError = 0)
  30.     THEN File_Exist := TRUE
  31.     ELSE File_Exist := FALSE;
  32. end; {File_Exist}
  33.  
  34. {***********************************************************************}
  35. function Find_File_Along_Path (File_Name : string) : string;
  36. begin
  37.   {*------------------------------------------------------------*}
  38.   {* Ok, Must check for file along the current PATH             *}
  39.   {* Starting with the current path                             *}
  40.   {*------------------------------------------------------------*}
  41.   Find_File_Along_Path := DOS.FSearch (File_Name, DOS.GetEnv('PATH'));
  42. end; {Find_File_Along_Path}
  43.  
  44.  
  45.  
  46.  
  47.  
  48. {***********************************************************************}
  49. {* Assumes path ends with a '/'   *}
  50. procedure Check_Valid_Path (Path_To_Ck     : string;
  51.                             VAR Ret_Status : integer);
  52. var
  53.   Curr_Path : string;
  54.   Dir       : DOS.DirStr;
  55.   Ext       : DOS.ExtStr;
  56.   Name      : DOS.NameStr;
  57.   Temp_Str  : string;
  58. begin
  59.   Ret_Status := 0;
  60.   Temp_Str := TRIM (Path_To_Ck);
  61.   IF (Temp_Str = '')
  62.     THEN Ret_Status := -1
  63.   ELSE
  64.     BEGIN
  65.       Temp_Str := DOS.FExpand (Temp_Str);
  66.       DOS.FSplit (Temp_Str, Dir, Name, Ext);
  67.       IF ((Name <> '') or (Ext <> ''))
  68.         THEN Ret_Status := -2
  69.       ELSE IF (POS (':', Dir) <> 2)
  70.         THEN Ret_Status := -3
  71.       ELSE IF ((POS ('\', Dir) <> 3))
  72.         THEN Ret_Status := -4
  73.       ELSE
  74.         BEGIN {* Looks ok, check if directory exists *}
  75.           GetDir (0, Curr_Path);
  76.           DEC(Temp_Str[0]); {cut off last '\'}
  77.           {$I-} ChDir (Temp_Str); {$I+}
  78.           IF (IoResult <> 0)
  79.             THEN Ret_Status := -5;
  80.           ChDir (Curr_Path);
  81.         END;
  82.     END; {if}
  83. end;  {Check_Valid_Path}
  84.  
  85.  
  86. {***********************************************************************}
  87. function Get_Unique_FileName : string;
  88. var
  89.   T_Hr, T_Min, T_Sec, T_100 : word;
  90. begin
  91.   DOS.GetTime (T_Hr, T_Min, T_Sec, T_100);
  92.   Get_Unique_FileName := Int_To_Str(T_Hr)+Int_To_Str(T_Min)+
  93.                          Int_To_Str(T_Sec)+Int_To_Str(T_100);
  94. end; {get_unique_filename}
  95.  
  96. {***********************************************************************}
  97. procedure Erase_File (File_Name  : string;
  98.                       Var Status : byte);
  99. VAR
  100.   f : file;
  101. begin
  102.   Status := 0;
  103.   Assign (F, File_Name);
  104.   {$I-} Reset (F); {I+}
  105.   IF (IOResult = 0) THEN
  106.     BEGIN
  107.       {$I-}
  108.       Close (F);
  109.       Erase (F);
  110.       {$I+}
  111.       IF (IOResult <> 0)
  112.         THEN Status := 2;
  113.     END
  114.   ELSE Status := 1;
  115. end; {erase_file}
  116.  
  117. end. {unit File_Lib}